home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / killer1a / killerbu.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-26  |  6.4 KB  |  155 lines

  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BackColor       =   &H80000018&
  4.    BorderStyle     =   0  'None
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   3705
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   5520
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3705
  14.    ScaleWidth      =   5520
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.CommandButton cmdNoBut 
  18.       Caption         =   "no"
  19.       BeginProperty Font 
  20.          Name            =   "MS Serif"
  21.          Size            =   6
  22.          Charset         =   0
  23.          Weight          =   400
  24.          Underline       =   0   'False
  25.          Italic          =   0   'False
  26.          Strikethrough   =   0   'False
  27.       EndProperty
  28.       Height          =   255
  29.       Left            =   3540
  30.       TabIndex        =   1
  31.       Top             =   2100
  32.       Width           =   375
  33.    End
  34.    Begin VB.Timer tmrFollow 
  35.       Enabled         =   0   'False
  36.       Interval        =   1
  37.       Left            =   3480
  38.       Top             =   1680
  39.    End
  40.    Begin VB.CommandButton cmdYesBut 
  41.       Caption         =   "Yes!  I love this program!"
  42.       BeginProperty Font 
  43.          Name            =   "MS Sans Serif"
  44.          Size            =   9.75
  45.          Charset         =   0
  46.          Weight          =   700
  47.          Underline       =   0   'False
  48.          Italic          =   0   'False
  49.          Strikethrough   =   0   'False
  50.       EndProperty
  51.       Height          =   615
  52.       Left            =   1500
  53.       TabIndex        =   0
  54.       Top             =   1860
  55.       Width           =   1575
  56.    End
  57.    Begin VB.Label Label1 
  58.       BackStyle       =   0  'Transparent
  59.       Caption         =   "Would you like to Register me?"
  60.       Height          =   255
  61.       Left            =   1680
  62.       TabIndex        =   2
  63.       Top             =   1440
  64.       Width           =   2295
  65.    End
  66. Attribute VB_Name = "frmMain"
  67. Attribute VB_GlobalNameSpace = False
  68. Attribute VB_Creatable = False
  69. Attribute VB_PredeclaredId = True
  70. Attribute VB_Exposed = False
  71. Option Explicit
  72. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  73.     'Sets the position of the window
  74. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  75.     'Set the parent of ANY object (can be lots of fun! ;-)
  76. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  77.     'Get the hWnd of the object's parent
  78. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  79.     'Get the current cursor Hot-Spot position
  80. Private Type POINTAPI
  81.         X As Long
  82.         Y As Long
  83. End Type
  84. Const a_Radius = 30 'Acceptable Radius the cursor can be
  85.                 'within for the button to 'grab' the cursor
  86. Const HWND_TOPMOST = -1
  87. Dim XnY As POINTAPI, ExitDo As Boolean
  88. Private Sub cmdNoBut_Click()
  89.     cmdYesBut.ZOrder 0  'Set the follower button to infront
  90.     tmrFollow.Enabled = True  'Start the button moving!
  91. End Sub
  92. Private Sub cmdYesBut_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  93.     'The Click event doesn't work when the button's parent is set to None
  94.     ExitDo = True
  95.     'Stop the Do..Loop from running, though you don't need
  96.     'this if you're going to unload the form like this
  97.     If GetParent(cmdYesBut.hwnd) <> Me.hwnd Then cmdYesBut.Visible = False
  98.     'If the parent was set to anything other than the form
  99.     'then make it invisible, so it wont get infront of the
  100.     'message box
  101.     MsgBox "          Why thankyou! :)" & Chr(13) & Chr(10) & "Killer Butter written by GEEZA" & Chr(13) & Chr(10) & "         GEEZA1@aol.com", vbApplicationModal + vbInformation, "hehe!"
  102.     Unload Me
  103.     End
  104. End Sub
  105. Private Sub tmrFollow_Timer()
  106.     GetCursorPos XnY
  107.     XnY.X = ScaleX(XnY.X, vbPixels, vbTwips) 'Change the dimensions from Pixels
  108.     XnY.Y = ScaleY(XnY.Y, vbPixels, vbTwips) 'to Twips
  109.     'Movement in X
  110.     If cmdYesBut.Left < 0 Then
  111.         cmdYesBut.Left = 0
  112.         Me.Left = Me.Left - 15  'push window
  113.     ElseIf cmdYesBut.Left + cmdYesBut.Width > Me.Width Then
  114.         cmdYesBut.Left = Me.Width - cmdYesBut.Width
  115.         Me.Left = Me.Left + 15  'push window
  116.     Else:
  117.         If cmdYesBut.Left + cmdYesBut.Width / 2 + Me.Left < XnY.X Then cmdYesBut.Left = cmdYesBut.Left + 30 Else cmdYesBut.Left = cmdYesBut.Left - 30
  118.     End If
  119.     'Movement in Y
  120.     If cmdYesBut.Top < 0 Then
  121.         cmdYesBut.Top = 0
  122.         Me.Top = Me.Top - 15
  123.     ElseIf cmdYesBut.Top + cmdYesBut.Height > Me.Height Then
  124.         cmdYesBut.Top = Me.Height - cmdYesBut.Height
  125.         Me.Top = Me.Top + 15
  126.     Else:
  127.         If cmdYesBut.Top + cmdYesBut.Height / 2 + Me.Top < XnY.Y Then cmdYesBut.Top = cmdYesBut.Top + 30 Else cmdYesBut.Top = cmdYesBut.Top - 30
  128.     End If
  129.     If (cmdYesBut.Left + cmdYesBut.Width / 2 + Me.Left < XnY.X + a_Radius) _
  130.         And (cmdYesBut.Left + cmdYesBut.Width / 2 + Me.Left > XnY.X - a_Radius) _
  131.         And (cmdYesBut.Top + cmdYesBut.Height / 2 + Me.Top > XnY.Y - a_Radius) _
  132.         And (cmdYesBut.Top + cmdYesBut.Height / 2 + Me.Top < XnY.Y + a_Radius) Then
  133.         'Within a_Radius twips of the center
  134.         '(pretty long IF statement huh?!)
  135.         tmrFollow.Enabled = False
  136.         Call StickButton(Me, cmdYesBut, cmdYesBut.Width / 2, cmdYesBut.Height / 2)
  137.     End If
  138. End Sub
  139. Private Sub StickButton(ByVal Form As Form, ByVal Button As CommandButton, DpX As Long, DpY As Long)
  140.     SetParent Button.hwnd, 0    'Sets the button's parent to none
  141.     SetWindowPos Button.hwnd, HWND_TOPMOST, 0, 0, 0, 0, 3 'Sets the button to be always on top
  142.     Button.Move Button.Left + Form.Left, Button.Top + Form.Top 'Make sure it's in the same position
  143.     Do
  144.         DoEvents    'So it doesn't 'Hang' the program
  145.         GetCursorPos XnY
  146.         XnY.X = ScaleX(XnY.X, vbPixels, vbTwips)
  147.         XnY.Y = ScaleY(XnY.Y, vbPixels, vbTwips)
  148.         Button.Left = XnY.X - DpX
  149.         Button.Top = XnY.Y - DpY
  150.         If ExitDo Then Exit Do
  151.     Loop  'Stick the Button to the cursor until ExitDo is true
  152.     'And they wont be able to click anything else!! hehe!
  153.     '...why not disable CTRL+ALT+DELETE? hehe!
  154. End Sub
  155.